环装热图绘制相关性

## 参考:https://www.jianshu.com/p/22081c67a153
mat1 = rbind(cbind(matrix(rnorm(50*5, mean = 1), nr = 50), 
                   matrix(rnorm(50*5, mean = -1), nr = 50)),
             cbind(matrix(rnorm(50*5, mean = -1), nr = 50), 
                   matrix(rnorm(50*5, mean = 1), nr = 50))
)
rownames(mat1) = paste0("R", 1:100)
colnames(mat1) = paste0("C", 1:10)
mat1 = mat1[sample(100, 100), ] # randomly permute rows

library(circlize)
library(ComplexHeatmap)
#绘制circoheatmap
col_fun1 = colorRamp2(c(-2, 0, 2), c("navy", "white", "firebrick3"))
circos.heatmap(mat1, col = col_fun1,dend.side = "inside",rownames.side = "outside")
#用于绘制legend
lgd = Legend(title = "mat1", col_fun = col_fun1)
grid.draw(lgd)
circos.clear()#一定要注意加上这个表示热图绘制完毕

col_fun1 = colorRamp2(c(-2, 0, 2), c("navy", "white", "firebrick3"))
circos.par(gap.after = c(10))#空出一段用于添加label
circos.heatmap(mat1, col = col_fun1,dend.side = "inside",rownames.side = "outside",track.height = 0.4)
circos.track(track.index = get.current.track.index(), panel.fun = function(x, y) {
  if(CELL_META$sector.numeric.index == 1) { # the last sector
    cn = colnames(mat1)
    n = length(cn)
    circos.text(rep(CELL_META$cell.xlim[2], n) + convert_x(0.1, "mm"), #x坐标
                13+(1:n)*5,#y坐标
                cn, #标签
                cex = 0.5, adj = c(0, 1), facing = "inside")
  }
}, bg.border = NA)
lgd = Legend(title = "mat1", col_fun = col_fun1)
grid.draw(lgd)
circos.clear()

#生成一组新的数据
mat2 = mat1[sample(100, 100), ] 

col_fun1 = colorRamp2(c(-2, 0, 2), c("navy", "white", "firebrick3"))
col_fun2 = colorRamp2(c(-2, 0, 2), c("green", "white", "red"))

circos.par(gap.after = c(10))
circos.heatmap(mat1, col = col_fun1,rownames.side = "outside",track.height = 0.2)
circos.heatmap(mat2, col = col_fun2,dend.side = "inside",track.height = 0.2)

lgd = Legend(title = "mat1", col_fun = col_fun1)
grid.draw(lgd)
circos.clear()

使用弦图绘制相关性

tt <- raster::stack(list.files("D:/XH/third_env/tt",pattern = "tif",full.names = T))

sa_exx <- na.exclude(raster::raster::extract(tt,xh_sa[,2:3]))
as_exx <- na.exclude(raster::raster::extract(tt,xh_as[,2:3]))
au_exx <- na.exclude(raster::raster::extract(tt,xh_au[,2:3]))
na_exx <- na.exclude(raster::raster::extract(tt,xh_na[,2:3]))

p_sa <- cor(sa_exx,method = "pearson")
p_as <- cor(as_exx,method = "pearson")
p_au <- cor(au_exx,method = "pearson")
p_na <- cor(na_exx,method = "pearson")


diag(p_sa) <- 0
pp_sa <- reshape2::melt(p_sa)
pp_sa1 <- pp_sa %>% .[which(.$value>=0.8 ),]
pp_sa2 <- pp_sa %>% .[which(.$value<=-0.8 ),]
pp_sa <- data.frame(rbind(pp_sa1,pp_sa2))

diag(p_au) <- 0
pp_au <- reshape2::melt(p_au)
pp_au1 <- pp_au %>% .[which(.$value>=0.8 ),]
pp_au2 <- pp_au %>% .[which(.$value<=-0.8 ),]
pp_au <- data.frame(rbind(pp_au1,pp_au2))


diag(p_as) <- 0
pp_as <- reshape2::melt(p_as)
pp_as1 <- pp_as %>% .[which(.$value>=0.8 ),]
pp_as2 <- pp_as %>% .[which(.$value<=-0.8 ),]
pp_as <- data.frame(rbind(pp_as1,pp_as2))


diag(p_na) <- 0
pp_na <- reshape2::melt(p_na)
pp_na1 <- pp_na %>% .[which(.$value>=0.8 ),]
pp_na2 <- pp_na %>% .[which(.$value<=-0.8 ),]
pp_na <- data.frame(rbind(pp_na1,pp_na2))


## 
library(circlize)
plot(0,type='n',axes=FALSE,ann=FALSE)
par(mfrow =c(2,2)) 

chordDiagram(pp_sa,
             annotationTrack = c('grid', 'name'), #绘制外周圆弧区，显示名称和刻度轴
             #根据相关性大小展示连线的颜色范围
             col = colorRamp2(c(-1,-0.8, 0,0.8, 1), c('blue', 'gray88','gray88','gray88', 'red'), transparency = 0),
             annotationTrackHeight = c(0.05, 0.05),
             symmetric = FALSE,link.sort = FALSE,
             title("SA_Alternanthera philoxeroides_ENVS_PEARSON", cex = 0.8)) #名称离圆弧的距离，以及圆弧的宽度

chordDiagram(pp_as,
             annotationTrack = c('grid', 'name'), #绘制外周圆弧区，显示名称和刻度轴
             #根据相关性大小展示连线的颜色范围
             col = colorRamp2(c(-1,-0.8, 0,0.8, 1), c('blue', 'gray88','gray88','gray88', 'red'), transparency = 0),
             annotationTrackHeight = c(0.05, 0.05),
             symmetric = FALSE,link.sort = FALSE,
             title("AS_Alternanthera philoxeroides_ENVS_PEARSON", cex = 0.8)) #名称离圆弧的距离，以及圆弧的宽度

chordDiagram(pp_au,
             annotationTrack = c('grid', 'name'), #绘制外周圆弧区，显示名称和刻度轴
             #根据相关性大小展示连线的颜色范围
             col = colorRamp2(c(-1,-0.8, 0,0.8, 1), c('blue', 'gray88','gray88','gray88', 'red'), transparency = 0),
             annotationTrackHeight = c(0.05, 0.05),
             symmetric = FALSE,link.sort = FALSE,
             title("AU_Alternanthera philoxeroides_ENVS_PEARSON", cex = 0.8)) #名称离圆弧的距离，以及圆弧的宽度

chordDiagram(pp_na,
             annotationTrack = c('grid', 'name'), #绘制外周圆弧区，显示名称和刻度轴
             #根据相关性大小展示连线的颜色范围
             col = colorRamp2(c(-1,-0.8, 0,0.8, 1), c('blue', 'gray88','gray88','gray88', 'red'), transparency = 0),
             annotationTrackHeight = c(0.05, 0.05),
             symmetric = FALSE,link.sort = FALSE,
             title("NA_Alternanthera philoxeroides_ENVS_PEARSON", cex = 0.8)) #名称离圆弧的距离，以及圆弧的宽度


## 导出不同大洲的输出JK检测结果：
jk_all <- data.frame(jk_au,jk_na,jk_as)
write.csv(jk_sa,"C:/Users/admin/Desktop/jk_sa.csv")
write.csv(jk_all,"C:/Users/admin/Desktop/jk_all.csv")

lm相关性统计

library(basicTrendline)
enm <- raster::extract(ped_as,xh_as[,2:3])
biox <- as.data.frame(raster::extract(envs_as,xh_as[,2:3]))
bioxx <- data.frame(cbind(biox,enm))
nam <- names(envs_as)
names(bioxx)
## 整体线性拟合：
par(mfrow =c(3,4)) 
for(i in 1:11){
  trendline(biox[,i], enm, model="line2P", ePos.x = NA, summary=TRUE, eDigit=5,main=nam[i],xlab = "")
}

lattice包-splom(df)

library(lattice)
splom(df)